Developer CD Series 1998 January: Mac OS SDK

home *** CD-ROM | disk | FTP | other *** search

/ Developer CD Series 1998 January: Mac OS SDK / Dev.CD Jan 98 SDK1.toast / Development Kits (Disc 1) / PCI Driver Development Kit / • Samples / Open Firmware Samples / SCSI example / AAPL-8250.of next >

Wrap

Text File | 1996-08-20 | 28.0 KB | 932 lines | [TEXT/MPS ]

\ FCode driver for NCR-8250 card \ ----------------------------------------------------------------------- \ Note: This driver works when errors are not encounted. I.e., the \ error handling is not correct and/or completely present. The code \ should be used as indicative of how a "scsi" device is partitioned \ into the "scsi" bus node (which performs the interactions with the \ hardware) and child nodes (e.g., "sd" for scsi-disk) that are opened \ with explict addressing that indicates the target-id and LUN. \ \ This driver is based upon the sample SCSI driver given in the IEEE-1275 \ Open Firmware document. In order to simplify testing, all of its \ files have been included into this one file. \ \ This driver also shows how to deal with endian-ness issues. The \ scripts that get used to perform I/O have to be placed into memory \ so that they are properly fetched by the 825. The code does explict \ "little-endian" stores that work regardless of the endian-ness of \ the memory system. \ \ Also note that DMA-MAP-IN is used to get the appropriate physical \ address of the scripts and data buffers, since the 825 will fetch \ script code and transfer data using physical memory addresses. \ ----------------------------------------------------------------------- tokenizer[ hex 1000 0003 010000 ]tokenizer PCI-HEADER FCode-Version2 hex " AAPL,NCR8250S" device-name \ Name of device node " NCR,8250S" model \ Manufacturer's model number " scsi" device-type \ Device implements SCSI-2 method set " NCR,8250S" encode-string " compatible" property \ same as this one 0 0 my-space encode-phys 0 encode-int encode+ 0 encode-int encode+ 0 0 02000014 my-space or encode-phys encode+ 0 encode-int encode+ 100 encode-int encode+ " reg" property external \ These routines may be called by the children of this device. \ This card has no local buffer memory for the SCSI device, so it \ depends on its parent to supply DMA memory. For a device with \ local buffer memory, these routines would probably allocate from \ that local memory. : dma-alloc ( n -- vaddr ) " dma-alloc" $call-parent ; : dma-free ( vaddr n -- ) " dma-free" $call-parent ; : dma-sync ( vaddr devaddr n -- ) " dma-sync" $call-parent ; : dma-map-in ( vaddr n cache? -- devaddr ) " dma-map-in" $call-parent ; : dma-map-out ( vaddr devaddr n -- ) " dma-map-out" $call-parent ; \ ----------------------------------------------------------------------- \ fload SCSIha.of \ This file contains the Hardware "Abstraction" layer of the driver. \ The device-specific drivers (e.g., "sd") call back into this code to \ handle all the details that are implementation-specific. \ ----------------------------------------------------------------------- headerless \ Note: since we actually only use a few of the registers for the \ driver, defining them all is somewhat wasteful. But they are all \ here for completeness. struct \ definition of registers; see NCR-825 document for their meanings /C field >SCNTL0 /C field >SCNTL1 /C field >SCNTL2 /C field >SCNTL3 /C field >SCID /C field >SXFER /C field >SDID /C field >GPREG /C field >SFBR /C field >SOCL /C field >SSID /C field >SBCL /C field >DSTAT /C field >SSTAT0 /C field >SSTAT1 /C field >SSTAT2 /L field >DSA /C field >ISTAT 3 + /C field >CTEST0 /C field >CTEST1 /C field >CTEST2 /C field >CTEST3 /L field >TEMP /C field >DFIFO /C field >CTEST4 /C field >CTEST5 /C field >CTEST6 3 field >DBC /C field >DCMD /L field >DNAD /L field >DSP /L field >DSPS /L field >SCRATCHA /C field >DMODE /C field >DIEN /C field >DWT /C field >DCNTL /L field >ADDER /C field >SIEN0 /C field >SIEN1 /C field >SIST0 /C field >SIST1 /C field >SLPAR /C field >SWIDE /C field >MACNTL /C field >GPCNTL /C field >STIME0 /C field >STIME1 /C field >RESPID0 /C field >RESPID1 /C field >STEST0 /C field >STEST1 /C field >STEST2 /C field >STEST3 /W field >SIDL 2 + /W field >SODL 2 + /W field >SBDL 2 + /L field >SCRATCHB drop 1 constant bus-reset \ Hardware result code that denotes an incoming \ SCSI bus reset \ Now that we have a symbolic name for the size of the register block, \ we can declare the "reg" property 0 value regs \ Virtual base address of device registers 0 instance value my-id \ host adapter's selection ID 0 instance value his-id \ target's selection ID 0 instance value his-lun \ target's unit number \ Map device registers : map ( -- ) " assigned-addresses" get-my-property abort" no ASSIGNED ADDRESSES" begin dup 0> while decode-phys dup FF and 14 = if 100 " map-in" $call-parent to regs 2drop exit then 3drop decode-int drop decode-int drop repeat true abort" no MEMORY ADDRESS" ; : unmap ( -- ) regs 100 " map-out" $call-parent 0 to regs ; : SIST@ regs >SIST1 rb@ 8 << regs >SIST0 rb@ or ; : ISTAT@ regs >ISTAT rb@ ; : ISTAT! regs >ISTAT rb! ; : DSTAT@ regs >DSTAT rb@ ; : SBCL@ regs >SBCL rb@ ; : DSP@ regs >DSP rl@ ; : DSP! regs >DSP rl! ; : DCMD@ regs >DCMD rb@ ; create reset-done-time 0 , create resetting false , \ 5 seconds appears to be about the right length of time to wait after \ a reset, considering a variety of disparate devices. d# 5000 value scsi-reset-delay : reset-wait ( -- ) resetting @ if begin get-msecs reset-done-time @ - 0>= until resetting off then begin istat@ 3 and while sist@ drop \ clear interrupt bits dstat@ drop repeat ; : RESET-825 ( -- ) \ reset the chip back to idle state begin \ clear up out internal state istat@ 3 and while sist@ drop \ clear interrupt bits dstat@ drop repeat 04 regs >CTEST3 rb! \ Clear DMA FIFO ; : RESET-SCSI-BUS ( -- ) 8 regs >SCNTL1 rb! \ assert RST/ 5 ms \ wait for 5 msecs 0 regs >SCNTL1 rb! \ then, de-assert 5 ms reset-825 \ After resetting the SCSI bus, we have to give the target devices \ some time to initialize their microcode. Otherwise the first command \ may hang, as with some older controllers. We note the time when it \ is okay to access the bus (now plus some delay), and "execute-command" \ will delay until that time is reached, if necessary. \ This allows us to overlap the delay with other work in many cases. get-msecs scsi-reset-delay + reset-done-time ! resetting on ; 0 value scsi-time \ Maximum command time in milliseconds 0 value time-limit \ Ending time for command 0 value istat \ value of ISTAT reg upon completion 0 value dstat \ value of DSTAT reg upon completion 0 value sist \ value of SIST<1:0> 0 value devaddr 0 value script-bfr \ address of scripting area 0 value script-bfr-p 0 value script-ptr \ ptr to next script loc'n 0 value status \ status byte addr (virtual) 0 value status-p \ status byte addr (physical) 0 value message \ status byte addr (virtual) 0 value message-p \ status byte addr (physical) 0 value cmd-bfr \ address of copied command area (always DMA-MAP'd-IN) 0 value cmd-bfr-p \ physical address of same : c!++ ( b addr -- addr' ) tuck c! 1+ ; : c@++ ( addr -- b addr' ) dup c@ swap 1+ ; : 4c!-le ( u a -- ) \ store script word in little-endian >r lbflip lbsplit r> c!++ c!++ c!++ c! ; : 4c@-le ( a -- u ) \ fetch script word in little-endian c@++ c@++ c@++ c@ bljoin ; : script, ( dbcmd-dbc dsps -- ) swap script-ptr 4c!-le script-ptr 4 + 4c!-le script-ptr 8 + to script-ptr ; \ Returns true if select failed : (exec) ( dma-adr,len dir cmd-adr,len -- hwresult ) reset-wait \ Delay until any prior reset operation to done \ create a script for this command script-bfr to script-ptr \ startup ptr 40000000 his-id d# 16 << or 0 script, \ SELECT tuck cmd-bfr swap move \ copy command to "well known place" his-lun 5 << cmd-bfr 1+ tuck c@ or swap c! \ add in LUN 02000000 or cmd-bfr-p script, \ COMMAND-OUT over ( len ) if \ DATA phase expected? ( dir ) if \ READ 01000000 \ ->DATA-IN else \ WRITE 00000000 \ ->DATA-OUT then or swap script, \ DATA-?? else \ no DATA phase, drop args drop 2drop then 03000001 status-p script, \ STATUS-IN 07000001 message-p script, \ MESSAGE-IN 60000440 0 script, \ clear /SACK & CARRY 98200000 0 script, \ INTERRUPT (CARRY clear) script-bfr-p dsp! \ start it up get-msecs scsi-time + to time-limit \ Set the time limit begin \ major loop begin \ sub-loop for command continuation after short transfer istat@ 3 and dup ?dup if \ save status if non-zero to istat then 0= while \ Wait until something happens scsi-time if \ If timeout is enabled, and get-msecs time-limit - 0>= if \ the time-limit has been reached, reset-scsi-bus true exit \ reset the bus and return error then then repeat istat 1 and if \ DMA interrupt dstat@ to dstat \ save for debugging then istat 2 and if \ SCSI interrupt sist@ to sist \ combined SCSI status sist 0400 and if \ STO -> device not present reset-825 true exit then sist 0004 and if \ if UDC and not my INTR, error dcmd@ 98 <> exit then sist 0002 and if \ RST, simply restart script-bfr-p dsp! then sist 0080 and if \ M/A, phase mis-match; possibly short data transfer dsp@ \ (physical) address of aborted command script-bfr-p - script-bfr + \ converting to virtual address 4c@-le 03000001 = if \ if its the STATUS-IN, we had short data dsp@ dsp! \ so, try to restart it then then then again \ major loop end ; \ Returns true if select failed : EXECUTE-COMMAND ( data-adr,len dir cmd-adr,len -- hwresult | statbyte false ) \ Put dir and cmd-adr,len on the return stack temporarily, to get them \ out of the way so we can work on the DMA data buffer. >r >r >r ( data-adr,len ) dup if ( data-adr,len ) \ If the data transfer has a non-zero length, we have to map it in 2dup false dma-map-in ( data-adr,len dma ) 2dup swap r> r> r> ( data-adr,len dma dma,len dir cmd-adr,len) (exec) ( data-adr,len phys hwres) >r swap dma-map-out r> ( hwresult ) else ( data-adr,len ) r> r> r> (exec) ( hwresult ) then ( hwresult ) ?dup 0= if ( hwresult | ) status c@ false \ Command finished; return status byte and false then ( hwresult | statbyte 0 ) ; external : RESET ( -- ) map reset-scsi-bus unmap ; \ reset \ Reset the SCSI bus when we are probed. : set-address ( unit target -- ) to his-id to his-lun ; : set-timeout ( msec-time -- ) to scsi-time ; headerless : config-w! " config-w!" $call-parent ; : config-w@ " config-w@" $call-parent ; : open-hardware ( -- flag ) map \ map-in our regs 6 my-space 4 + tuck config-w@ or swap config-w! \ enable Memory Space & Master Mode h# 33 regs >SCNTL3 rb! \ initialize clocks h# 0C regs >STIME0 rb! \ selection time-out 7 regs >SCID rb! \ our ID true ; : reopen-hardware ( -- flag ) true ; : close-hardware ( -- ) unmap ; : reclose-hardware ( -- ) ; \ ----------------------------------------------------------------------- \ fload SCSIhacom.of \ \ The following code is intended to be independent of the details of the \ SCSI hardware implementation. It is loaded after the hardware-dependent \ file that defines execute-command, set-address, open-hardware, etc. \ ----------------------------------------------------------------------- 0 value inq-buf \ inquiry data buffer 0 value sense-buf \ holds extended error information 0 value #retries ( -- n ) \ number of times to retry SCSI transaction \ Classifies the sense condition as either okay (0), retryable (1), \ or non-retryable (-1) : classify-sense ( -- 0 | 1 | -1 ) \ debug? if ." Sense: " sense-buf 11 cdump ." ..." cr then sense-buf \ Make sure we understand the error class code dup c@ 7F and 70 <> if drop -1 exit then ( sense-buf ) \ Check for filemark, end-of-media, or illegal block length 2+ c@ dup E0 and if drop -1 exit then ( sense-key-byte ) 0F and ( sense-key ) \ no_sense(0) and recoverable(1) are okay dup 1 <= if drop 0 exit then ( sense-key ) \ not-ready(2) and attention(6) are retryable dup 2 = swap 6 = or if 1 else -1 then ; 0 value open-count external \ The SCSI device node defines an address space for its children. That \ address space is of the form "target#,unit#". target# and unit# are \ both integers. parse-2int converts a text string (e.g. "3,4") into \ a pair of binary integers. : DECODE-UNIT ( addr len -- unit# target# ) parse-2int ; : OPEN ( -- flag ) open-count if reopen-hardware dup if open-count 1+ to open-count then exit else open-hardware dup if 100 dma-alloc to sense-buf 100 dma-alloc to inq-buf 100 dma-alloc to script-bfr \ get area for our scripts (virtual address) script-bfr 100 false dma-map-in to script-bfr-p \ physical address script-bfr 0D0 + to status script-bfr-p 0D0 + to status-p script-bfr 0D4 + to message script-bfr-p D4 + to message-p script-bfr 0E0 + to cmd-bfr \ place to copy command script-bfr-p 0E0 + to cmd-bfr-p 1 to open-count then then ; : CLOSE ( -- ) open-count 1- to open-count open-count if reclose-hardware else close-hardware script-bfr 100 dma-free inq-buf 100 dma-free sense-buf 100 dma-free then ; : MAX-TRANSFER ( -- n ) \ Note: due to a bug in the A2 ROM, this value is smaller than it should be. \ It should be 01000000 (i.e., 16 MB) due to the 24-bit DBC register. 1000 ( 4 KB ) ; headerless : get-sense ( -- ) \ Issue REQUEST SENSE, which is not supposed to fail sense-buf FF true " "(03000000FF00)" execute-command 0= if drop then ; \ Give the device a little time to recover before retrying the command. : delay-retry ( -- ) 1000 0 do loop ; 0 value statbyte \ Local variable used by retry? \ RETRY? is used by RETRY-COMMAND to determine whether or not to retry the \ command, considering the following factors: \ - Success or failure of the command at the hardware level (failure at \ this level is usually fatal, except in the case of an incoming bus reset) \ - The value of the status byte returned by the command \ - The condition indicated by the sense bytes \ - The number of previous retries \ \ The input arguments are as returned by "scsi-exec" \ On output, the top of the stack is true if the command is to be retried, \ otherwise the top of the stack is false and the results that should be \ returned by retry-command are underneath it; those results indicate the type \ of error that occurred. : retry? ( hw-result | statbyte 0 -- true | [[sensebuf] f-hw] error? false ) case 0 of to statbyte endof \ No hardware error; continue checking bus-reset of true exit endof \ Retry after incoming bus reset ( hw-result ) true false exit \ Other hardware errors are fatal endcase statbyte 0= if false false exit then \ If successful, return "no-error" statbyte 2 and if \ "Check Condition", so get extended status get-sense classify-sense case ( -1|0|1 ) \ If the sense information says "no sense", return "no-error" 0 of false false exit endof \ If the error is fatal, return "sense-buf,valid,statbyte" -1 of sense-buf false statbyte false exit endof endcase \ Otherwise, the error was retryable. However, if we have \ have already retried the specified number of times, don't \ retry again; instead return sense buffer and status. #retries 0= if sense-buf false statbyte false exit then then \ Don't retry if vendor-unique, reserved, intermediate, or \ "condition met/good" bits are set. Return "no-sense,status" statbyte F5 and if true statbyte false exit then \ Don't retry if we have already retried the specified number \ of times. Return "no-sense,status" #retries 0= if true statbyte false exit then \ Otherwise, it was either a busy or a retryable check condition, \ so we retry. true ; external \ RETRY-COMMAND executes a SCSI command. If a check condition is indicated, \ performs a "get-sense" command. If the sense bytes indicate a non-fatal \ condition (e.g. power-on reset occurred, not ready yet, or recoverable \ error), the command is retried until the condition either goes away or \ changes to a fatal error. \ \ The command is retried until: \ a) The command succeeds, or \ b) The select fails, or dma fails, or \ c) The sense bytes indicate an error that we can't retry at this level \ d) The number of retries is exceeded. \ #retries is number of times to retry (0: don't retry, -1: retry forever) \ \ sensebuf is the address of the sense buffer; it is present only \ if f-hw is 0 and error? is non-zero. The length of the sense buffer \ is 8 bytes plus the value in byte 7 of the sense buffer. \ \ f-hw is non-zero if there is a hardware error -- dma fails, select fails, \ etc -- or if the status byte was neither 0 (okay) nor 2 (check condition) \ \ error? is non-zero if there is a transaction error. If error? is 0, \ f-hw and sensebuf are not returned. \ \ If sensebuf is returned, the contents are valid until the next call to \ retry-command. sensebuf becomes inaccessable when this package is closed. \ \ dma-dir is necessary because it is not always possible to infer the DMA \ direction from the command. \ Local variables used by retry-command? 0 value dbuf \ Data transfer buffer 0 value dlen \ Expected length of data transfer 0 value direction-in \ Direction for data transfer -1 value cbuf \ Command base address 0 value clen \ Actual length of this command : retry-command ( dma-buf dma-len dma-dir cmdbuf cmdlen #retries -- ... ) ( ... -- [[sensebuf] f-hw] error? ) to #retries to clen to cbuf to direction-in to dlen to dbuf begin dbuf dlen direction-in cbuf clen execute-command ( hwerr | stat 0 ) retry? while #retries 1- to #retries delay-retry repeat ; \ Collapses the complete error information returned by retry-command into \ a single error/no-error flag. : error? ( false | true true | sensebuf false true -- error? ) dup if swap 0= if nip then then ; \ Simplified "retry-command" routine for commands with no data transfer phase \ and simple error checking requirements. : NO-DATA-COMMAND ( cmd len -- error? ) >r >r 0 0 true r> r> -1 retry-command error? ; \ short-data-command executes a command with the following characteristics: \ a) The data direction is incoming \ b) The data length is less than 256 bytes \ The host adapter driver is responsible for supplying the DMA data \ buffer; if the command succeeds, the buffer address is returned. \ The buffer contents become invalid when another SCSI command is \ executed, or when the driver is closed. : short-data-command ( data-len cmdbuf cmdlen -- true | buffer false ) >r >r inq-buf swap true r> r> -1 retry-command ( retry-cmd-results ) error? dup 0= if inq-buf swap then ; headerless \ Here begins the implementation of "show-children", a word that \ is intended to be executed interactively, showing the user the \ devices that are attached to the SCSI bus. \ Tool for storing a big-endian 24-bit number at an unaligned address : 3c! ( n addr -- ) >r lbsplit drop r@ c! r@ 1+ c! r> 2+ c! ; \ Command block template for Inquiry command : inquiry ( -- error? ) \ 8 retries should be more than enough; inquiry commands aren't \ supposed to respond with "check condition". inq-buf FF true " "(12000000FF00)" 8 retry-command error? ; \ Returns true if the target number "select-id" responds to the inquiry \ command. : probe-target ( select-id -- present? ) 0 swap set-address inquiry 0= ; \ Reads the indicated byte from the Inquiry data buffer : inq@ ( offset -- value ) inq-buf + c@ ; : .scsi1-inquiry ( -- ) inq-buf 5 ca+ 4 inq@ 0FA min type ; : .scsi2-inquiry ( -- ) inq-buf 8 ca+ d# 28 type ; \ Displays the results of an Inquiry command to the indicated device : show-lun ( unit target -- ) over swap set-address ( unit ) inquiry if drop exit then ( unit ) 0 inq@ 7F = if drop exit then ( unit ) ." Unit " . ." " 1 inq@ 80 and if ." Removable " then 0 inq@ case 0 of ." Disk " endof 1 of ." Tape " endof 2 of ." Printer " endof 3 of ." Processor " endof 4 of ." WORM " endof 5 of ." Read Only device" endof ( default ) ." Device type " dup .h endcase 1 inq@ 7F and ?dup if ." Qualifier " .h then 4 spaces 3 inq@ 0F and 2 = if .scsi2-inquiry else .scsi1-inquiry then cr ; external \ Searches for devices on the SCSI bus, displaying the Inquiry information \ for each device that responds. : show-children ( -- ) open 0= if ." Can't open SCSI host adapter" cr exit then cr 8 0 do i probe-target if ." Target " i . cr 8 0 do i j show-lun loop then loop close ; headerless \ ----------------------------------------------------------------------- \ fload SCSIdisk.of \ SCSI disk package implementing a "block" device-type interface. \ ----------------------------------------------------------------------- new-device \ SD " sd" device-name " block" device-type \ ----------------------------------------------------------------------- \ fload scsicom.of \ Utility routines for SCSI commands \ This file contains some words which are useful for both SCSI disk and \ SCSI tape device drivers. \ \ The SCSI disk and SCSI tape packages need to export dma-alloc and dma-free \ methods so the deblocker can allocate DMA-capable buffer memory. \ ----------------------------------------------------------------------- external : dma-alloc ( n -- vaddr ) " dma-alloc" $call-parent ; : dma-free ( vaddr n -- ) " dma-free" $call-parent ; headerless : parent-max-transfer ( -- n ) " max-transfer" $call-parent ; \ Calls the parent device's "retry-command" method. The parent device is \ assumed to be a driver for a SCSI host adapter (device-type = "scsi") : retry-command ( dma-addr dma-len dma-dir cmd-addr cmd-len #retries -- ... ) ( ... -- false ) \ No error ( ... -- true true ) \ Hardware error ( ... -- sensebuf false true ) \ Fatal error with extended status " retry-command" $call-parent ; \ Simplified command execution routines for common simple command forms : no-data-command ( cmd len -- error? ) " no-data-command" $call-parent ; : short-data-command ( data-len cmdbuf cmdlen -- true | buffer false ) " short-data-command" $call-parent ; \ ----------------------------------------------------------------------- \ SCSIdisk.of (continued) \ Some tools for reading and writing 2, 3, and 4 byte numbers to and from \ SCSI command and data buffers. The ones defined below are used both in \ the SCSI disk and the SCSI tape packages. Other variations that are \ used only by one of the packages are defined in the package where they \ are used. \ ----------------------------------------------------------------------- : 3c! ( n addr -- ) >r lbsplit drop r> c!++ c!++ c! ; : c@-- ( addr -- n addr' ) dup c@ swap 1- ; : 3c@ ( addr -- n ) 2 + c@-- c@-- c@ 0 bljoin ; : 4c@ ( addr -- n ) 3 + c@-- c@-- c@-- c@ bljoin ; \ "Scratch" command buffer useful for construction of read and write commands create cmdbuf 0 c, 0 c, 0 c, 0 c, 0 c, 0 c, 0 c, 0 c, 0 c, 0 c, : cb! ( byte index -- ) cmdbuf + c! ; \ Write byte to command buffer \ The deblocker converts a block/record-oriented interface to a byte-oriented \ interface, using internal buffering. Disk and tape devices are usually \ block or record oriented, but the OBP external interface is byte-oriented, \ in order to be independent of particular device block sizes. 0 instance value deblocker : init-deblocker ( -- okay? ) 0 0 " deblocker" $open-package to deblocker deblocker if true else ." Can't open deblocker package" cr false then ; \ 0 means no timeout : set-timeout ( msecs -- ) " set-timeout" $call-parent ; 0 instance value offset-low \ Offset to start of partition 0 instance value offset-high 0 instance value label-package \ Sets offset-low and offset-high, reflecting the starting location of the \ partition specified by the "my-args" string. : init-label-package ( -- okay? ) 0 to offset-high 0 to offset-low my-args " disk-label" $open-package to label-package label-package if 0 0 " offset" label-package $call-method to offset-high to offset-low true else ." Can't open disk label package" cr false then ; \ Ensures that the disk is spinning, but doesn't wait forever : timed-spin ( -- error? ) d# 15000 set-timeout " "(1B0100000100)" no-data-command d# 1000 set-timeout ; 0 instance value /block \ Device native block size : read-block-size ( -- n ) \ Ask device about its block size \ First try "mode sense" - data returned in bytes 9,10,11 d# 12 " "(1A0000000C00)" short-data-command if 0 else 9 + 3c@ then ?dup if exit then \ Failing that, try "read-capacity" - data returned in bytes 4,5,6,7 8 " "(250000000C0000000000)" short-data-command if 0 else 4 + 4c@ then ?dup if exit then d# 512 \ Default to 512 if the device won't tell us ; \ Read or write "#blks" blocks starting at "block#" into memory at "addr" \ Input? is true for reading or false for writing. \ command is 8 for reading or h# a for writing : 2c! ( n addr -- ) >r lbsplit 2drop r> c!++ c! ; : 4c! ( n addr -- ) >r lbsplit r> c!++ c!++ c!++ c! ; : r/w-blocks ( addr block# #blks input? command -- actual# ) 3 pick 100000 u>= if \ Use 10-byte form ( addr block# #blks dir cmd ) h# 20 or 0 cb! \ 28 (read) or 2A (write) ( addr block# #blks dir ) -rot swap ( addr dir #blks block# ) cmdbuf 2 + 4c! ( addr dir #blks ) dup cmdbuf 7 + 2c! else \ Use 6-byte form ( addr block# #blks dir cmd ) 0 cb! ( addr block# #blks dir ) -rot swap ( addr dir #blks block# ) cmdbuf 1+ 3c! ( addr dir #blks ) dup 4 cb! ( addr dir #blks ) then dup >r ( addr input? #blks ) /block * swap ( addr #bytes input? ) cmdbuf dup c@ 20 and if d# 10 else 6 then -1 ( addr #bytes input? cmd cmdlen #retries ) retry-command if ( [ sensebuf ] hw? ) 0= if drop then r> drop 0 else r> then ( actual# ) ; external \ These three methods are called by the deblocker. \ Return device block size; cache it the first time we find the information \ This method is called by the deblocker : BLOCK-SIZE ( -- n ) /block if /block exit then \ Don't ask if we already know read-block-size dup to /block ; : MAX-TRANSFER ( -- n ) parent-max-transfer ; : READ-BLOCKS ( addr block# #blocks -- #read ) 0 >r \ big block done counter begin 100 over < while \ do it in smaller pieces 2 pick 2 pick 100 true 08 r/w-blocks r> + >r rot 100 /block * + \ update addr rot 100 + \ block# rot 100 - \ #blocks repeat ( addr' block#' #blocks' ) ?dup if true 08 r/w-blocks \ do last segment r> + else \ just ended right 2drop r> then ; : WRITE-BLOCKS ( addr block# #blocks -- #written ) 0 >r \ big block done counter begin 100 over < while \ do it in smaller pieces 2 pick 2 pick 100 false 0A r/w-blocks r> + >r rot 100 /block * + \ update addr rot 100 + \ block# rot 100 - \ #blocks repeat ( addr' block#' #blocks' ) ?dup if false 0A r/w-blocks \ do last segment r> + else \ just ended right 2drop r> then ; \ Methods used by external clients : OPEN ( -- flag ) my-unit " set-address" $call-parent \ It might be a good idea to do an inquiry here to determine the \ device configuration, checking the result to see if the device \ really is a disk. \ Make sure the disk is spinning timed-spin if false exit then block-size to /block init-deblocker 0= if false exit then init-label-package 0= if deblocker close-package false exit then true ; : CLOSE ( -- ) label-package ?dup if close-package then deblocker ?dup if close-package then ; : SEEK ( offset.low offset.high -- okay? ) offset-low offset-high d+ " seek" deblocker $call-method ; : READ ( addr len -- actual-len ) " read" deblocker $call-method ; : WRITE ( addr len -- actual-len ) " write" deblocker $call-method ; : LOAD ( addr -- size ) " load" label-package $call-method ; finish-device \ SD FCode-End PCI-END